			
package FileTable::Record;

use strict;

use Fcntl;
use Carp;
use DBI;
use FileTable::Log;

# We're still under "use strict" from file header...
use vars qw($MAXRECSIZE $maxstorelen $LOCK_EX);

# maxstorelen is a debug variable, tracking largest stored record
$maxstorelen = 0;

# Configuration constants
# This one fits well with use of MySQL with default TEXT size.
# Note that record will have 2 of these....
$MAXRECSIZE = 65000;
# Constants for flock() locking
$LOCK_EX = 2;

# Data lookup
sub tablename {
    my $self = shift;
    return $self->{"*FILE"}->{_TABLE};
}

#
# The record operations - store();
#
sub store {
    my $self = shift;
    my $opt = shift; # Optional argument - can be NOTEXT
    my $textform;
    my $key = $self->key;
    my $file = $self->{"*FILE"};
    my $textfile = "$file->{'*NAME'}.txt";
    my $lastfile = "$file->{'*NAME'}.last";
    my $numberkey = 0;
    my $dbh = $self->{"*FILE"}->dbhandle();
    my $table = $self->tablename;


    die "Error: Store() called on read-only file, mode = $$file{_MODE},  expr = ", $$file{_MODE} & O_RDWR, "\n"
	if (($$file{_MODE} & O_RDWR) == 0);
    die "Error: Key is not defined in store()\n" if ! defined($key);
    if ($file->{"*keystyle"} && $file->{"*keystyle"} eq "number") {
	if ($key !~ /^\d+$/) {
	    die "Error: $key is not a numeric key\n";
	}
	$numberkey = 1;
    }
    $textform = $self->textform();
    if (!defined($opt) || $opt ne "NOTEXT") {
	# Database log
	if ($self->stored()) {
	    if ($self->stored() eq "placeholder") {
		FileTable::Log::log($table, $key, $textform, "new");
	    } else {
		FileTable::Log::log($table, $key, $textform, "update");
	    }
	} else {
	    FileTable::Log::log($table, $key, $textform, "new");
	 }
	# Append the record to the textfile, trying to lock exclusively
	if ($] > 5.008) {
	    # explicit unicode encoding - and new enough perl
	    open(TEXTFILE, ">>:utf8", $textfile) || die "Unable to open $textfile\n";
	} else {
	    open(TEXTFILE, ">>$textfile") || die "Unable to open $textfile\n";
	}
	flock(TEXTFILE,$LOCK_EX);
	# and, in case someone appended
	# while we were waiting...
	seek(TEXTFILE, 0, 2);
	print TEXTFILE "//$key\n$textform";
	close TEXTFILE;
    }
    # Store a (possibly truncated) version in the SDBM file
    my $size = length($textform);
    if ($size > $MAXRECSIZE) {
	warn "$textfile: rec $key too large - $size, truncating to $MAXRECSIZE\n";
	$textform = substr($textform, 0, $MAXRECSIZE - 1);
	$textform .= "\n";
	$size = length($textform);
	warn "Size is now $size\n";
    } 
    if ($size == 0) {
	carp "CHANGED BEHAVIOUR 2003-05-31: Storing empty record - this used to delete it";
    }
    # Update secondary info files
    $self->storeclean($textform);
    # Update LASTNUM if it is being bypassed.
    # Note that this is a bit unsafe.....newnum() shouldn't be used
    # until all get(..O_CREAT) requests are processed....
# HTA 2005-02-16: Removed the whole lastnum thing
#    if ($numberkey && $key > $file->{"*LASTNUM"}) {
#    	open(LASTNUM, ">$lastfile") || die "Unable to open $textfile\n";
#	flock(LASTNUM, $LOCK_EX);
#	seek(LASTNUM, 0, 0);
#	print LASTNUM $key, "\n";
#	close LASTNUM;
#	$file->{"*LASTNUM"} = $key;
#    }
    $self->stored(1); # Make rekey impossible
}

#
# Store without writing to logfile.
# Also intended to NOT be redefined in derived classes, so that
# it does not invoke additional functionality (like timestamping)
#
sub patch {
    my $self = shift;
    # use local store() routine, not record's defined store()
    store($self, "NOTEXT");
}

sub textform {
# NOTE: must be in close sync with "makeobject" routine
# elsewhere in this file
# There's no real reason for the sort - it just makes the sequence of
# keys predictable, which makes testing easier.

    my $self = shift;
    my $textform = "";
    my $field;
    for $field (sort(keys(%$self))) {
	# note 981112: made this very much more restrictive
	if ($field =~ /^([-a-z0-9A-Z_]+)$/) {
	    my $val = $self->{$field};
	    $val =~ s/\\/\\\\/g;
	    $val =~ s/\n/\\n/g;
	    $textform .= "$field:$val\n";
	}
    }
    $textform;
}

# Internal: Store a record - write f_raw, all other fields
# Uses MySQL REPLACE function.
sub storeclean {
    my $self = shift;
    my $textform = "";
    my $rawtext = shift;
    my $key = $self->{"*KEY"};
    my $file = $self->{"*FILE"};
    my $dbh = $file->dbhandle();
    my $table = $self->tablename();
    my $cleanrec;
    my $elm;
    my $field;
    my $size;

    if ($file->{"*CLEAN"}) {
	$cleanrec = $file->{"*VALID"}->clean($self);
    } else {
	$cleanrec = $self;
    }
    for $field (keys(%$cleanrec)) {
	if ($field !~ /^\*/) {
	    $textform .= "$field:$cleanrec->{$field}\n";
	}
    } 
    $size = length($textform);
    if ($size > $MAXRECSIZE) {
	my $textfile = $file->{'*NAME'};
	warn "$textfile: clean rec $key too large - $size, truncating to $MAXRECSIZE\n";
	$textform = substr($textform, 0, $MAXRECSIZE - 1);
	$textform .= "\n";
	$size = length($textform);
	warn "Size is now $size\n";
    }
    # Build the correct UPDATE statement piecewise.
    # Not TERRIBLY nice....
    my @fields;
    undef @fields;
    my $update;
    if ($self->stored()) {
	$update = "REPLACE $table SET f_key=?, f_raw=?, f_clean=?";
    } else {
	$update = "INSERT $table SET f_key=?, f_raw=?, f_clean=?";
    }
    push(@fields, $key);
    push(@fields, $rawtext);
    push(@fields, $textform);
    my $stm;
    my @elms;
    ($stm, @elms) = $self->fieldlist($cleanrec);
    $update .= $stm;
    push(@fields, @elms);
    #warn "Updating with $update values(", join(", ", @fields), ")\n";
    # Track largest stored object
    my $len = length($textform);
    my $sth = $dbh->prepare($update);
    if ($sth->execute(@fields)) {
	if ($len > $maxstorelen) {
	    $maxstorelen = $len;
	    #warn "Maxstorelen now $maxstorelen\n";
	}
    } else {
	die "Store clean failed - op $update, size $len, success $maxstorelen";
    }
}    


sub clean {
    my $self = shift;
    my $textform;
    my $key = $self->{"*KEY"};
    my $file = $self->{"*FILE"};
    my $dbh = $file->dbhandle();
    my $table = $self->tablename();
    my $cleanrec;
    my $elm;
    my $field;

    if ($file->{"*CLEAN"}) {
	$cleanrec = $file->{"*VALID"}->clean($self);
    } else {
	warn "Not cleaned\n";
	$cleanrec = $self;
    }
    for $field (keys(%$cleanrec)) {
	if ($field !~ /^\*/) {
	    $textform .= "$field:$cleanrec->{$field}\n";
	}
    } 
    my $size = length($textform);
    if ($size > $MAXRECSIZE) {
	my $textfile = $file->{'*NAME'};
	warn "$textfile: clean rec $key too large - $size, truncating to $MAXRECSIZE\n";
	$textform = substr($textform, 0, $MAXRECSIZE - 1);
	$textform .= "\n";
	$size = length($textform);
	warn "Size is now $size\n";
    }
    # Build the correct UPDATE statement piecewise.
    # Not TERRIBLY nice....
    my @fields;
    my $update = "UPDATE $table SET f_clean=?";
    push(@fields, $textform);
    my $stm;
    my @elms;
    ($stm, @elms) = $self->fieldlist($cleanrec);
    $update .= $stm;
    push(@fields, @elms);
    $update .= " WHERE f_key = ?";
    push(@fields, $key);
    #warn "Updating with $update values(", join(" ", @fields), ")\n";
    # Track largest stored object
    my $len = length($textform);
    my $sth = $dbh->prepare($update);
    if ($sth->execute(@fields)) {
	if ($len > $maxstorelen) {
	    $maxstorelen = $len;
	}
    } else {
	die "Store clean failed - op $update, size $len, success $maxstorelen";
    }
}    

sub fieldlist {
# Return list of fields & array of values
# Elm 1 returned is piece of REPLACE/UPDATE
# Elm 2... are the values to insert
    my $self = shift;
    my $cleanrec = shift;
    my $file = $self->{"*FILE"};
    my $dbh = $file->dbhandle();
    my $table = $self->tablename();
    # FIXME: Change to use _DBINFO structure
    my @dbfields = @{$file->{_DBFIELDS}};
    my @dbfieldtypes = @{$file->{_DBFIELDTYPES}};
    my $fieldix;
    my $field;
    my $type;
    my $update = "";
    my @fields;
    my $elm;

    for $fieldix (0..$#dbfields) {
	$field = $dbfields[$fieldix];
        $type = $dbfieldtypes[$fieldix];
	undef $elm;
	if ($field eq "f_key" || $field eq "f_raw" || $field eq "f_clean") {
	    next;
	} elsif ($field =~ /index$/) {
	    # For some reason, the INDEXES sneak into the typelist.
	    # this is very bad juju - we only have a naming convention
	    # to get away from them.
	    # This happened in mSQL - doesn't seem to happen in MySQL
	    warn "Found index $field in table $table\n";
	    next;
	} else {
	    if (defined($$cleanrec{$field})) {
		if ($type == DBI::SQL_INTEGER) { # garg.....
		    $elm = $$cleanrec{$field} + 0; # Enforce int
		} else {
		    $elm = $$cleanrec{$field};
		}
		$update .= ", $table.$field=?";
		push(@fields, $elm);
	    } else {
		# NOTE: this works perfect for REPLACE INTO when all the
		# fields are NOT NULL, but may leave junk lying around
		# when recleaning does an UPDATE, not a REPLACE.
		# Not sure this is a problem.
	    }
	}
    }
    return($update, @fields);
}

sub key {
    my $self = shift;
    return $self->{"*KEY"};
}

sub stored {
    my $self = shift;
    my $arg = shift;
    if (defined($arg)) {
	my $temp = $self->{"*STORED"};
	$self->{"*STORED"} = $arg;
	return $temp;
    } else {
	return $self->{"*STORED"};
    }
}

sub setkey {
    my $self = shift;
    my $newkey = shift;
    die "Record already keyed and stored\n" if $self->stored();
    $self->{"*KEY"} = $newkey;
}

# Add a key to the record with newnumber()
sub newkey {
    my $self = shift;
    my $file = $self->{"*FILE"};
    my $key = $file->_newnumber();
    die "Record already keyed and stored\n" if $self->stored();
    $self->setkey($key);
    $self->stored("set by newkey");
}

sub fields {
    my $self = shift;
    return grep(/^[a-z0-9A-Z]/, keys(%$self));
}

sub new {
    my $self = {};
    my $class = shift;
    
    bless($self, $class);
}

sub clear {
    my $self = shift;
    my $key;
    carp "Clear has been deprecated - use delete";
    for $key (keys(%$self)) {
	delete $$self{$key} unless $key =~ /^\*/;
    }
}

sub delete {
    my $self = shift;
    my $opt = shift;
    my $key = $self->{"*KEY"};
    my $file = $self->{"*FILE"};
    my $dbh = $file->dbhandle();
    my $table = $self->tablename();
    my $textfile = $file->{'*NAME'} . ".txt";


    my $stm = $dbh->prepare("DELETE FROM $table WHERE f_key = ?");
    $stm->execute($key)
	    || die "Execute delete failed";
    if (!defined($opt) || $opt ne "NOTEXT") {
        FileTable::Log::log($table, $key, "", "delete");
        # Append the record to the textfile, trying to lock exclusively
        open(TEXTFILE, ">>$textfile") || die "Unable to open $textfile\n";
        flock(TEXTFILE,$LOCK_EX);
        # and, in case someone appended
        # while we were waiting...
        seek(TEXTFILE, 0, 2);
	# special record....
        print TEXTFILE "//$key\nf_state:DELETED\n//$key\n";
        close TEXTFILE;
    }
    # Make sure it crashes if used again
    delete $self->{"*FILE"};
    delete $self->{"*KEY"};

}

sub append {
    my $self = shift;
    my $field = shift;
    my $value = shift;

    if ($self->{$field}) {
	$self->{$field} .= " $value";
    } else {
	$self->{$field} = $value;
    }
}

# Give others access to the validator routines
sub validator {
    my $self = shift;
    my $file = $self->{"*FILE"};
    return $file->{"*VALID"};
}

# Attempt to kill off database entry if created with newnum()
# and never stored
sub DESTROY {
    my $self = shift;
    if ($self->{"*FILE"}) {
	# possible to have recs with no file refs if it has been delete()d
	# in that case, it's OK not to clean up
	if ($self->stored() && $self->stored() eq "placeholder") {
	    my $key = $self->key();
	    carp "DESTROY called on placeholder record $key - deleting";
	    $self->delete();
	}
    }
}


1;
